Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/ftp_srv2/ftp_srv.frm

Text File | 1997-12-17 | 15KB | 503 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "FTP SERVER"
   ClientHeight    =   4650
   ClientLeft      =   1470
   ClientTop       =   2820
   ClientWidth     =   7335
   Height          =   5055
   Icon            =   FTP_SRV.FRX:0000
   Left            =   1410
   LinkTopic       =   "Form1"
   ScaleHeight     =   4650
   ScaleWidth      =   7335
   Top             =   2475
   Width           =   7455
   Begin TextBox Text1
      Enabled         =   0   'False
      Height          =   612
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   4
      Text            =   "If you want any explanation or wish my collaboration for any project, contact me through e-mail at [e-mail] (refer to Anastasi Lorenzo)."
      Top             =   3960
      Width           =   7092
   End
   Begin PictureBox EndCmd
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   0
      Top             =   0
      Width           =   1000
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Index           =   4
      Interval        =   50
      Left            =   2040
      Top             =   4680
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Index           =   3
      Interval        =   50
      Left            =   1560
      Top             =   4680
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Index           =   2
      Interval        =   50
      Left            =   1080
      Top             =   4680
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Index           =   1
      Interval        =   50
      Left            =   600
      Top             =   4680
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Index           =   0
      Interval        =   50
      Left            =   120
      Top             =   4680
   End
   Begin PictureBox StatusBar
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   2
      Top             =   0
      Width           =   1000
   End
   Begin PictureBox Frame3D1
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   3
      Top             =   0
      Width           =   1000
      Begin ListBox LogWnd
         BackColor       =   &H00000000&
         ForeColor       =   &H0000FF00&
         Height          =   2328
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   6612
      End
   End
   Begin PictureBox VBServer1
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   5
      Top             =   0
      Width           =   1000
   End
End
Sub EndCmd_Click ()
Dim i As Integer

  'close all connection
  For i = 1 To MAX_N_USERS
    If users(i).control_slot <> INVALID_SOCKET Then
      'close control slot
      retf = CloseTheSocket(users(i).control_slot)
    End If
    If users(i).data_slot <> INVALID_SOCKET Then
      'close data slot
      retf = CloseTheSocket(users(i).data_slot)
    End If
  Next

  'end FTP server
  retf = WSACleanup()
  End

End Sub

Sub Form_Load ()
Dim i As Integer
Dim hdr As String, item As String
  '--- Initialization
  'an FTP command is terminated by Carriage_Return +
  'Line_Feed
  crlf = Chr$(13) + Chr$(10)
  'possible sintax errors in FTP commands
  sintax_error_list(0) = "200 Command Ok."
  sintax_error_list(1) = "202 Command not implemented, superfluous at this site."
  sintax_error_list(2) = "500 Sintax error, command unrecognized."
  sintax_error_list(3) = "501 Sintax error in parameters or arguments."
  sintax_error_list(4) = "502 Command not implemented."
  sintax_error_list(6) = "504 Command not implemented for that parameter."
  'initializes the list which contains the names,
  'passwords, access rights and default directory
  'recognized by the server
  Open WORK_DIR + "\ftp_srv.ini" For Input As NF_INI
  Line Input #NF_INI, hdr  'usernames
  If hdr = "[usernames]" Then
    For i = 1 To N_RECOGNIZED_USERS
      Line Input #NF_INI, item
      usernames_list(i) = item
    Next
  Else
    StatusBar.Caption = "Error in INI file!"
    End
  End If
  Line Input #NF_INI, hdr  'passwords
  If hdr = "[passwords]" Then
    For i = 1 To N_RECOGNIZED_USERS
      Line Input #NF_INI, item
      passwords_list(i) = item
    Next
  Else
    StatusBar.Caption = "Error in INI file!"
    End
  End If
  Line Input #NF_INI, hdr  'access rights
  If hdr = "[access_rights]" Then
    For i = 1 To N_RECOGNIZED_USERS
      Line Input #NF_INI, item
      access_rights_list(i) = item
    Next
  Else
    StatusBar.Caption = "Error in INI file!"
    End
  End If
  Line Input #NF_INI, hdr  'default directories
  If hdr = "[default_dirs]" Then
    For i = 1 To N_RECOGNIZED_USERS
      Line Input #NF_INI, item
      default_dir_list(i) = item
    Next
  Else
    StatusBar.Caption = "Error in INI file!"
    End
  End If
  Close #NF_INI

  'initializes the records which contain the
  'informations on the connected users
  For i = 1 To MAX_N_USERS
    users(i).list_index = 0
    users(i).control_slot = INVALID_SLOT
    users(i).data_slot = INVALID_SLOT
    users(i).IP_address = ""
    users(i).Port = 0
    users(i).data_representation = "A"
    users(i).data_format_ctrls = "N"
    users(i).data_structure = "F"
    users(i).data_tx_mode = "S"
    users(i).cur_dir = ""
    users(i).state = 0
    users(i).full = False
  Next

  'begins SERVER mode on port 21
  VBServer1.Port = 21
  VBServer1.SelectAction = FD_ACCEPT Or FD_CLOSE Or FD_READ Or FD_WRITE
  VBServer1.OpenFlag = True
  ServerSlot = VBServer1.SocketNumber

End Sub

Sub Form_Unload (Cancel As Integer)

  retf = WSACleanup()

End Sub

Sub Timer1_Timer (index As Integer)
Dim close_data_cnt As Integer
Dim error_on_data_cnt As Integer

Select Case files_info(index).retr_stor

  Case 0:
  '--- R E T R  Command
  If files_info(index).data_representation = "A" Then
    If Not files_info(index).open_file Then
      'open file
      Open files_info(index).full_name For Input Lock Write As #index
      files_info(index).open_file = True
    End If
    'sends the file on data connection;
    'data are sent a line at a time
    If files_info(index).try_again Then
      're-send old line
    Else
      Line Input #index, files_info(index).buffer
    End If
    retf = send_data(files_info(index).buffer + crlf, index)
    If retf < 0 Then 'SOCKET_ERROR
      retf = WSAGetLastError()
      If retf = WSAEWOULDBLOCK Then
        files_info(index).try_again = True
      Else
        'error on sending
        error_on_data_cnt = True
        close_data_cnt = True
      End If
    Else
      files_info(index).try_again = False
    End If
    If EOF(index) Then close_data_cnt = True
  Else  'binary transfer
    If Not files_info(index).open_file Then
      'open file
      Open files_info(index).full_name For Binary Lock Write As #index
      files_info(index).open_file = True
    End If
    'sends file on data connection;
    'data are sent in blocks of 1024 bytes
    If files_info(index).next_block = 0 Then
      files_info(index).file_len = LOF(index)
      '# of blocks
      files_info(index).blocks = Int(files_info(index).file_len / 1024)
      '# of remaining bytes
      files_info(index).spare_bytes = files_info(index).file_len Mod 1024
      files_info(index).buffer = String$(1024, " ")